Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/attacvb4/send32.frm

Visual Basic Form | 1997-07-30 | 6.6 KB | 208 lines

VERSION 4.00
Begin VB.Form Form1
   Caption         =   "Form1"
   ClientHeight    =   2385
   ClientLeft      =   3720
   ClientTop       =   3150
   ClientWidth     =   3825
   Height          =   2790
   Left            =   3660
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2385
   ScaleWidth      =   3825
   Top             =   2805
   Width           =   3945
   Begin VB.Frame Frame1
      Caption         =   "Send Attachment"
      Height          =   2175
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   3615
      Begin VB.CommandButton Command1
         Caption         =   "Send Attachment"
         Height          =   375
         Left            =   1320
         TabIndex        =   4
         Top             =   1560
         Width           =   2055
      End
      Begin VB.TextBox Text3
         Height          =   285
         Left            =   1320
         TabIndex        =   3
         Top             =   1080
         Width           =   2055
      End
      Begin VB.TextBox Text2
         Height          =   285
         Left            =   1320
         TabIndex        =   2
         Top             =   720
         Width           =   2055
      End
      Begin VB.TextBox Text1
         Height          =   285
         Left            =   1320
         TabIndex        =   1
         Top             =   360
         Width           =   2055
      End
      Begin MailLib.mMail Mail1
         Left            =   120
         Top             =   1560
         _Version        =   327680
         _ExtentX        =   847
         _ExtentY        =   847
         _StockProps     =   0
         Blocking        =   -1  'True
         Debug           =   0
         Host            =   ""
         Timeout         =   0
         ConnectType     =   0
         PopPort         =   110
         SmtpPort        =   25
      End
      Begin VB.Label Label3
         Alignment       =   1  'Right Justify
         Caption         =   "File:"
         Height          =   255
         Left            =   360
         TabIndex        =   7
         Top             =   1080
         Width           =   855
      End
      Begin VB.Label Label2
         Alignment       =   1  'Right Justify
         Caption         =   "SMTP Server:"
         Height          =   255
         Left            =   120
         TabIndex        =   6
         Top             =   720
         Width           =   1095
      End
      Begin VB.Label Label1
         Alignment       =   1  'Right Justify
         Caption         =   "To:"
         Height          =   255
         Left            =   360
         TabIndex        =   5
         Top             =   360
         Width           =   855
      End
   End
Attribute VB_Name = "Form1"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Private Sub Command1_Click()
    Dim boundary As Double
    Dim strFilename As String
    On Error GoTo Some_Err
    'validate entries
    If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Then
        MsgBox "Please fill in all values.", vbExclamation, "Missing Value"
        Exit Sub
    End If
    strFilename = GetFileFromPath
    Mail1.Debug = 1
    'create a new message
    Mail1.Action = MailActionNewMessage
    Mail1.Date = Format$(Now(), "ddd, dd mmm yyyy hh:mm:ss")
    '
    'Your user friendly name
    Mail1.From = "Your Name"
    '
    'The return e-mail address
    Mail1.EMailAddress = "[e-mail]"
    '
    'the lucky recipient
    Mail1.To = Text1.Text
    Mail1.Subject = "Example of attachments"
    'create the headers for the message
    '
    'each multi-part message must have the 'parts'
    'separated by a unique boundry.
    boundary = Fix(Rnd * 100000000000#)
    Mail1.ContentType = "multipart"
    Mail1.ContentSubtype = "mixed"
    Mail1.ContentSubtypeParameters = "boundary=" & CStr(boundary) & "_boundary"
    Mail1.MultipartBoundary = CStr(boundary) & "_boundary"
    'this is the attachment 'part'
    Mail1.Action = MailActionCreatePart
    Mail1.Action = MailActionDescend
    Mail1.ContentType = "application"
    Mail1.ContentSubtype = "x-uuencode"
    Mail1.ContentSubtypeParameters = "name=" & Chr$(34) & _
        strFilename & Chr$(34)
    Mail1.ContentTransferEncoding = "x-uuencode"
    Mail1.ContentDisposition = "attachment; filename=" & Chr$(34) & strFilename & Chr$(34)
    Mail1.Flags = MailSrcIsFile Or MailDstIsBody
    Mail1.SrcFilename = Text3.Text
    Mail1.Action = MailActionEncode
    Mail1.Action = MailActionAscend
    'create the text 'part' of the message
    Mail1.Action = MailActionCreatePart
    Mail1.Action = MailActionDescend
    Mail1.ContentType = "text"
    Mail1.ContentSubtype = "plain"
    Mail1.ContentSubtypeParameters = "charset=us-ascii"
    Mail1.ContentTransferEncoding = "7bit"
    Mail1.Body(0) = "This is the text 'part'"
    Mail1.Action = MailActionAscend
    'basic host configuration
    Mail1.Blocking = True
    Mail1.Host = Text2.Text
    Mail1.ConnectType = MailConnectTypeSMTP
    'send the message
    Command1.Enabled = False
    MousePointer = 11
    Mail1.Action = MailActionConnect
    Mail1.Flags = MailDstIsHost
    Mail1.Action = MailActionWriteMessage
    Mail1.Action = MailActionDisconnect
    MousePointer = 0
    Command1.Enabled = True
    Exit Sub
Some_Err:
    MsgBox CStr(Err.Number) & " " & Err.Description
    On Error Resume Next
    Mail1.Action = MailActionDisconnect
    MousePointer = 0
    Command1.Enabled = True
End Sub
Private Sub Form_Load()
End Sub
Private Sub Frame1_DragDrop(Source As Control, X As Single, Y As Single)
End Sub
Private Sub Label1_Click()
End Sub
Private Sub Mail1_Debug(ByVal Message As String)
    Debug.Print Message
End Sub
Private Function GetFileFromPath() As String
    '
    'this is a crude hack used to determine
    'a filename from a complete path/file
    '
    'loop through the complete path/file
    'backwards, looking for the first
    '"\" char.
    Dim i As Integer
    i = Len(Text3.Text)
    For i = Len(Text3.Text) To 1 Step -1
        If Mid$(Text3.Text, i, 1) = "\" Then
            Exit For
        End If
    Next i
    If i > 1 Then
        GetFileFromPath = Right$(Text3.Text, Len(Text3.Text) - i)
    Else
        GetFileFromPath = Text3.Text
    End If
End Function
Private Sub Text1_Change()
End Sub